home *** CD-ROM | disk | FTP | other *** search
/ Otherware / Otherware_1_SB_Development.iso / mac / developm / language / xlispst.cpt / XLisp-Stat ƒ / Disk 1 / oneway.lsp < prev    next >
Encoding:
Lisp/Scheme  |  1990-08-15  |  4.2 KB  |  139 lines
  1. ;;;; XLISP-STAT 2.1 Copyright (c) 1990, by Luke Tierney
  2. ;;;; Additions to Xlisp 2.1, Copyright (c) 1989 by David Michael Betz
  3. ;;;; You may give out copies of this software; for conditions see the file
  4. ;;;; COPYING included with this distribution.
  5.  
  6. (provide "oneway")
  7.  
  8. (require "regression")
  9.  
  10. ;;;;
  11. ;;;;
  12. ;;;; One Way ANOVA Model Prototype
  13. ;;;;
  14. ;;;;
  15.  
  16. (defproto oneway-model-proto '(grouped-data) '() regression-model-proto)
  17.  
  18. (defun oneway-model (data &key (print t) group-names)
  19. "Args: ( data &key (print t))
  20. DATA: list of compound-data
  21. Example:"
  22.   (let ((data (mapcar #'(lambda (x) (coerce x 'list)) data))
  23.         (m (send oneway-model-proto :new)))
  24.     (send m :grouped-data data)
  25.     (send m :group-names group-names)
  26.     (if print (send m :display))
  27.     m))
  28.  
  29. (defmeth oneway-model-proto :display ()
  30. "Message args: ()
  31. Prints the least squares regression summary."
  32.   (call-next-method)
  33.   (format t "Group Mean Square:     ~10g   ~A~%"
  34.           (send self :group-mean-square) (list (send self :group-df)))
  35.   (format t "Error MeanSquare:      ~10g   ~A~%"
  36.           (send self :error-mean-square) (list (send self :error-df)))
  37.   (format t "~%"))
  38.  
  39. (defmeth oneway-model-proto  :save ()
  40. "Message args: ()
  41. Returns an expression that will reconstruct the model."
  42.   `(oneway-model ',(send self :grouped-data) 
  43.                  :group-names ',(send self :group-names)))
  44.                        
  45. ;;;
  46. ;;; Slot Accessors and Mutators
  47. ;;;
  48.  
  49. (defmeth oneway-model-proto :grouped-data (&optional data)
  50. "Message args: (&optional data)
  51. Sets or returns the grouped data."
  52.   (when data
  53.         (let* ((y (apply #'append data))
  54.                (indices (repeat (iseq 0 (- (length data) 1)) 
  55.                                 (mapcar #'length data)))
  56.                (levels (remove-duplicates indices))
  57.                (indicators (mapcar #'(lambda (x) (if-else (= x indices) 1 0))
  58.                                    levels))
  59.                (x (apply #'bind-columns indicators)))
  60.           (setf (slot-value 'y) y)
  61.           (setf (slot-value 'x) x)
  62.           (setf (slot-value 'intercept) nil)
  63.           (setf (slot-value 'grouped-data) data)
  64.           (send self :needs-computing t)))
  65.    (slot-value 'grouped-data))
  66.  
  67. (defmeth oneway-model-proto :group-names (&optional (names nil set))
  68. "Method args: (&optional names)
  69. Sets or returns group names."
  70.   (if set (setf (slot-value 'predictor-names) names))
  71.   (let ((g-names (slot-value 'predictor-names))
  72.         (ng (length (slot-value 'grouped-data))))
  73.     (if (not (and g-names (= ng (length g-names))))
  74.         (setf (slot-value 'predictor-names)
  75.               (mapcar #'(lambda (a) (format nil "Group ~a" a)) 
  76.                       (iseq 0 (- ng 1))))))
  77.   (slot-value 'predictor-names))
  78.  
  79. ;;;
  80. ;;; Overrides for Linear Regression Methods
  81. ;;;
  82.  
  83. (defmeth oneway-model-proto :y ()
  84. "
  85. Message args: ()
  86. Returns the response vector."
  87.    (call-next-method))
  88.  
  89. (defmeth oneway-model-proto :x ()
  90. "Message args: ()
  91. Returns the design matrix."
  92.    (call-next-method))
  93.  
  94. (defmeth oneway-model-proto :intercept (&rest args)
  95. "Message args: ()
  96. Always returns nil. For compatibility with linear regression."
  97.   nil)
  98.  
  99. (defmeth oneway-model-proto :predictor-names () (send self :group-names))
  100.  
  101. ;;;
  102. ;;; Other Methods
  103. ;;;
  104.  
  105. (defmeth oneway-model-proto :standard-deviations ()
  106. "Message args: ()
  107. Returns list of within group standard deviations."
  108.   (mapcar #'standard-deviation (send self :grouped-data)))
  109.   
  110. (defmeth oneway-model-proto :group-df () 
  111. "Message args: ()
  112. Returns degrees of freedom for groups."
  113.     (- (length (send self :grouped-data)) 1))
  114.  
  115. (defmeth oneway-model-proto :group-sum-of-squares ()
  116. "Message args: ()
  117. Returns sum of squares for groups."
  118.   (sum (^ (- (send self :fit-values) (mean (send self :y))) 2)))
  119.  
  120. (defmeth oneway-model-proto :group-mean-square ()
  121. "Message args: ()
  122. Returns mean square for groups."
  123.     (/ (send self :group-sum-of-squares) (send self :group-df)))
  124.     
  125. (defmeth oneway-model-proto :error-df ()
  126. "Message args: ()
  127. Returns degrees of freedom for error."
  128.     (send self :df))
  129.     
  130. (defmeth oneway-model-proto :error-mean-square ()
  131. "Message args: ()
  132. Returna mean square for error."
  133.     (/ (send self :sum-of-squares) (send self :df)))
  134.     
  135. (defmeth oneway-model-proto :boxplots ()
  136. "Message args: ()
  137. Produce parallel box plots of the groups."
  138.     (boxplot (send self :grouped-data)))
  139.